home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Complete Applications / Screen Savers / ZOOM.Pas
Encoding:
Pascal/Delphi Source File  |  1986-10-20  |  1.5 KB  |  85 lines  |  [TEXT/ttxt]
  1. UNIT ZOOM;
  2.  
  3. INTERFACE
  4.  
  5. USES MacIntf;
  6.  
  7. procedure ZoomRect(VAR smallRect,bigRect: Rect; zoomUp: BOOLEAN);
  8.  
  9. IMPLEMENTATION
  10.  
  11. procedure ZoomRect;
  12.  
  13. const zoomSteps = 16;
  14.  
  15. var
  16.     rect1,rect2,
  17.     rect3,rect4    : Rect;
  18.     i,j                : INTEGER;
  19.     savePort,
  20.       thisPort        : GrafPtr;
  21.     fract,factor,
  22.       one                : Fixed;
  23.     
  24.     function Blend(smallCoord,bigCoord: INTEGER): INTEGER;
  25.     var smallFix,bigFix,tempFix: Fixed;
  26.     begin
  27.         smallFix:=one * smallCoord;
  28.         bigFix  :=one * bigCoord;
  29.         tempFix :=FixMul(fract,bigFix) + FixMul(one-fract,smallFix);
  30.         Blend   :=FixRound(tempFix);
  31.     end;
  32.  
  33. begin
  34.   GetPort(savePort);
  35.   thisPort := GrafPtr(NewPtr(SizeOf(GrafPort)));
  36.   OpenPort(thisPort);
  37.   InitPort(thisPort);
  38.   SetPort(thisPort);
  39.   PenPat(gray);
  40.   PenMode(notPatXor);
  41.  
  42.   one:=65536;
  43.   IF zoomUp
  44.   then
  45.     begin
  46.       rect1:=smallRect;
  47.       factor:=FixRatio(6,5);
  48.       fract:=FixRatio(541,10000);
  49.     end
  50.   else
  51.     begin
  52.       rect1:=bigRect;
  53.       factor:=FixRatio(5,6);
  54.       fract:=one;
  55.     end;
  56.  
  57.   rect2:=rect1;
  58.   rect3:=rect1;
  59.   FrameRect(rect1);
  60.  
  61.   for i:=1 to zoomSteps do
  62.     begin
  63.       rect4.left   :=Blend(smallRect.left,bigRect.left);
  64.       rect4.right  :=Blend(smallRect.right,bigRect.right);
  65.       rect4.top    :=Blend(smallRect.top,bigRect.top);
  66.       rect4.bottom :=Blend(smallRect.bottom,bigRect.bottom);
  67.  
  68.       FrameRect(rect4);
  69.       FrameRect(rect1);
  70.       rect1:=rect2;
  71.       rect2:=rect3;
  72.       rect3:=rect4;
  73.  
  74.       fract:=FixMul(fract,factor);
  75.     end;
  76.   FrameRect(rect1);
  77.   FrameRect(rect2);
  78.   FrameRect(rect3);
  79.   PenNormal;
  80.   ClosePort(thisPort);
  81.   SetPort(savePort);
  82. end;
  83.  
  84. end.
  85.